perm filename CREIO[G,BGB]1 blob
sn#050719 filedate 1973-06-27 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00015 PAGES
00200 C REC PAGE DESCRIPTION
00300 C00001 00001
00400 C00003 00002 TITLE CREIO - CRE INPUT OUTPUT SUBROUTINES - BGB - 16 APRIL 1973.
00500 C00006 00003 SUBR(FILNUM)SERIAL. SETUP FILE-SERIAL-NUMBER-NAME.
00600 C00008 00004 SUBR(TVDSKI)SERIAL INPUT TV PICTURE FROM DISK FILE.
00700 C00010 00005 SUBR(TVPACK). PACK TVBUF WITH PICTURE FROM SKY ARRAY.
00800 C00013 00006 SUBR(TVDSKO) INPUT TV PICTURE FROM A DISK FILE.
00900 C00015 00007 SUBR(TVXGP) VIDEO BUFFER TO XEROX GRAPHICS PRINTER.
01000 C00018 00008 GRAB THE DEVICE.
01100 C00021 00009 SUBR(VICXGP)Q1,Q2 VIDEO INTENSITY CONTOURS TO XGP.
01200 C00023 00010
01300 C00024 00011
01400 C00027 00012 SUBR(CREOUT) OUTPUT CONTOURS, REGION, EDGE FILE.
01500 C00029 00013 SUBR(CREIN) CONTOUR,REGION,EDGE FILE FORMAT INPUT.
01600 C00031 00014 TVIN4. FOUR BIT TELEVISION INPUT.
01700 C00033 00015 SUBR(TVIN6). SIX BIT TELEVISION INPUT.
01800 C00038 ENDMK
01900 C⊗;
00100 TITLE CREIO - CRE INPUT OUTPUT SUBROUTINES - BGB - 16 APRIL 1973.
00200
00300 EXTERN REMAIN,NODCNT,FTVHIS,FTVSIX
00400 EXTERN VCUT,TVBUF,HISTO,AVAIL2,CRE44,FILM,FLGBGB
00500 EXTERN HEADER,HISTOG,CHR
00600 EXTERN DPYBUF,QBLK,DPYIMG
00700 EXTERN RELLOC,SHRINQ,SKY
00800 EXTERN FILNAM,EXTION,PPPN,GETFIL
00100 SUBR(FILNUM)SERIAL. ;SETUP FILE-SERIAL-NUMBER-NAME.
00200 BEGIN FILNUM;------------------------------------------------------
00300 EXTERN FNAME6
00400 LAC 10,FNAME6↔LAC 1,[POINT 6,10,-1] ;FILM NAME SIXBIT.
00500 LAC 0,1↔ILDB 2,1↔SKIPE 2↔GO .-3 ;SCAN FOR 00.
00600
00700 ;CONVERT SERIAL NUMBER TO SIXBIT DECIMAL NUMERAL.
00800 LACM 1,ARG1↔DAC 1,2↔DAC 1,3↔DAC 1,4↔DAC 1,5
00900 CAIL 1,=10000↔GO L5
01000 CAIL 1,=1000↔GO L4
01100 CAIL 1,=100↔GO L3
01200 CAIL 1,=10↔GO L2
01300 ↔GO L1
01400
01500 L5: IDIVI 1,=10000↔ADDI 1,20↔IDPB 1,0
01600 L4: IDIVI 2,=1000 ↔ADDI 2,20↔IDPB 2,0
01700 L3: IDIVI 3,=100 ↔ADDI 3,20↔IDPB 3,0
01800 L2: IDIVI 4,=10 ↔ADDI 4,20↔IDPB 4,0
01900 L1: ADDI 5,20↔IDPB 5,0
02000 DAC 10,FILNAM
02100
02200 ;TMP EXTENSION AND PPPN.
02300 LAC[SIXBIT/TMP/]↔DAC EXTION
02400 DZM EXTION+1
02500 DZM↔SKIPE FLGBGB↔LAC[SIXBIT/DATBGB/]↔DAC PPPN
02600 POP1J
02700
02800 BEND FILNUM; BGB 19 APRIL 1973 ------------------------------------
00100 SUBR(TVDSKI)SERIAL INPUT TV PICTURE FROM DISK FILE.
00200
00300 COMMENT/ Serial -1 asks user for file name. Serial ≥0 attempts
00400 film image XXXX00.TMP input. TVDSKI returns TRUE -1 if image
00500 found or FALSE 0 if image not found./
00600
00700 BEGIN TVDSKI;-----------------------------------------------------
00800
00900 SKIPL 1,ARG1↔GO[CALL(FILNUM,1)↔GO L1]
01000 L0: CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DATBGB/])
01100 FALSE: GO[DZM 1↔POP1J] ;RETURN FALSE - NO PICTURE.
01200 L1: INIT 1,17↔SIXBIT/DSK/↔0↔HALT
01300 LOOKUP 1,FILNAM↔GO[SKIPGE ARG1↔GO L0↔GO FALSE]
01400
01500 MOVS PPPN↔MOVMS ;GET FILE SIZE.
01600 CAIN 24400↔GO L2
01700 SUBI 200↔DACN
01800 DIP DUMP2+1
01900 IN 1,DUMP2↔JFCL ;NON-STANDARD SIZE.
02000 CALL(TVPACK)
02100 GO L4
02200
02300 L2: IN 1,DUMP1↔JFCL ;216 x 288 STANDARD SIZE.
02400 L4: OUTSTR[ASCIZ" EOF.
02500 "]↔ RELEASE 1,↔SETO 1,↔POP1J ;RETURN TRUE.
02600
02700 DUMP1: IOWD 200,HEADER
02800 IOWD 24200,TVBUF↔0
02900 DUMP2: IOWD 200,HEADER
03000 IOWD 24200,SKY↔0
03100
03200 BEND TVDSKI; BGB 6 DECEMBER 1972 ---------------------------------
00100 SUBR(TVPACK). PACK TVBUF WITH PICTURE FROM SKY ARRAY.
00200 COMMENT/ Take a non-standard size picture from the SKY array and pack
00300 it into the TVBUF. TVPACK loops are for R ← 0 to 215 and for C ← 0 to
00400 287; at each target pixel a check is made to see if there is a source
00500 pixel to be moved./
00600 BEGIN TVPACK;-----------------------------------------------------
00700
00800 ACCUMULATORS{B,R1,C1,R2,C2,Q0,Q1,Q2}
00900
01000 ;READ TV FILE HEADER & MAKE SURE THAT IT IS REASONIBLE.
01100 SETO↔CAME HEADER↔GO[OUTSTR[ASCIZ/ UNKNOWN, TV FILE FORMAT.
01200 /]↔POP0J]
01300 LAC HEADER+1↔DAC BYTSIZ#
01400 LAC HEADER+2↔DAC WWIDTH#
01500 LAC HEADER+4↔SUB HEADER+3↔AOS↔DAC MROWS#↔LSH -1↔DAC HALFM#
01600 LAC HEADER+6↔SUB HEADER+5↔AOS↔DAC NCOLS#↔LSH -1↔DAC HALFN#
01700
01800 LAC R2,HALFM↔SUBI R2,=108
01900 LAC Q0,R2↔IMUL Q0,WWIDTH
02000 ADDI Q0,SKY↔CDR 0,HEADER+7↔SUBI 0,200↔ADD Q0,0
02100 LAC Q2,[POINT 6,TVBUF,-1]
02200 DZM R1
02300 L0: DZM C1↔LAC C2,HALFN↔SUBI C2,=144
02400 L1: DZM B
02500 SKIPL R2↔CAML R2,MROWS↔GO L2
02600 SKIPL C2↔CAML C2,NCOLS↔GO L2
02700 TLNN Q0,-1↔CALL(L3)
02800 ILDB B,Q1
02900 LSH B,0
03000 L2: IDPB B,Q2
03100 AOS C2↔AOS C1↔CAIE C1,=288↔GO L1
03200 ADD Q0,WWIDTH↔LAC Q1,Q0
03300 AOS R2↔AOS R1↔CAIE R1,=216↔GO L0
03400 POP0J
03500
03600 ;COMPUTE SOURCE COLUMN BYTE POINTER, ONCE PER PICTURE.
03700 L3: LAC 0,C2↔IDIV 0,BYTSIZ↔ADD Q0,0 ;WORD.
03800 IMUL 1,BYTSIZ↔LACI 0,=36↔SUB 0,1 ;P-BITS.
03900 LSH 0,6↔IOR 0,BYTSIZ↔ROT 0,-=12 ;S-BITS.
04000 IOR Q0,0↔LAC Q1,Q0
04100 LACI 6↔SUB BYTSIZ↔DAP L2-1
04200 POP0J
04300
04400 BEND TVPACK; BGB 18 APRIL 1973 -----------------------------------
00100 SUBR(TVDSKO) INPUT TV PICTURE FROM A DISK FILE.
00200 BEGIN TVDSKO;-----------------------------------------------------
00300
00400 CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DATBGB/])↔POP0J
00500 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
00600 ENTER 1,FILNAM↔GO[OUTSTR[ASCIZ/ ENTER FAILED.
00700 /]↔GO .+4]
00800 LAC[XWD HEADER,HEADER+1]↔DZM HEADER↔BLT HEADER+177
00900 LAC[XWD HEAD1,HEADER]↔BLT HEADER+7
01000 OUT 1,DUMARG↔JFCL
01100 OUTSTR[ASCIZ" EOF.
01200 "]↔ RELEASE 1,↔POP0J
01300 HEAD1: -1
01400 6 ; BITS PER BYTE.
01500 =48 ;WORDS PER LINE.
01600 =20 ;FIRST AND LAST ROW.
01700 =235
01800 =28
01900 =315 ;FIRST AND LAST COL.
02000 XWD -=10368,200
02100 DUMARG: IOWD 24400,HEADER↔0
02200 BEND TVDSKO; BGB 6 DECEMBER 1973 ---------------------------------
00100 SUBR(TVXGP) VIDEO BUFFER TO XEROX GRAPHICS PRINTER.
00200 BEGIN TVXGP;------------------------------------------------------
00300 ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2}
00400 COMMENT/ One to sixteen expansion: (216*4=864) by (288*4=1152).
00500 or 32 words per line. Buffer size (864 lines)*33+1= 28513 words./
00600
00700 ;EXPAND CORE FOR XGP BUFFER & CLEAR THE BUFFER.
00800 LAC 44↔DAC SAV44#↔AOS↔DAC XBUF#↔ADDI =28513+10↔CORE↔GO L5
00900 CDR 1,XBUF↔DZM(1)↔DIP 1,1↔AOS 1↔CDR 2,44↔BLT 1,(2)
01000
01100 ;PUT CONTROL WORDS IN THE 864 ROWS OF THE XGP IMAGE.
01200 LAC 1,XBUF
01300 SLACI %↔DAC(1)↔AOS 1 ;CUT PAPER.
01400 SLACI =200⊗6↔DAC(1)↔AOS 1 ;SPACE DOWN 100 LINES.
01500 LAC[1B11+=192B23+=32]↔LACI 2,=864 ;864 ROWS OF 32 WORDS.
01600 DAC(1)↔ADDI 1,=33↔SOJG 2,.-2
01700 LAC[5770B11]↔DAC(1)↔AOS 1 ;SPACE AFTER PICTURE.
01800 SLACI %↔DAC(1) ;CUT PAPER.
01900
02000 ;PACK VIDEO BYTES INTO XGP 4 BY 4 BIT ARRAYS.
02100 LAC P1,[POINT 6,TVBUF,-1]
02200 LAC P2,XBUF↔ADDI P2,3 ;BUFFER POINTER.
02300 LACI I,=216
02400 L1: LACI J,=32
02500 L2: SETZB 0,1↔SETZB 2,3↔LACI K,=9
02600 L3: ILDB Q,P1↔TRZ Q,3↔ROTC 0,4↔ROTC 2,4
02700 IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)
02800 IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)
02900 SOJG K,L3
03000 DAC 0,=00(P2)↔DAC 1,=33(P2)
03100 DAC 2,=66(P2)↔DAC 3,=99(P2)
03200 AOS P2↔SOJG J,L2
03300 ADDI P2,=100↔SOJG I,L1
03400
00100 ;GRAB THE DEVICE.
00200 L4: INIT 1,117
00300 SIXBIT/XGP/↔0↔GO[OUTSTR[ASCIZ/XGP INIT FAILED.
00400 /]↔ POP0J]
00500 SETZ↔SEGNUM
00600 DAC SAVSEG#↔DETSEG
00700 LOCK
00800
00900 ;SLACI -=28516
01000 LAP XBUF↔SOS↔ LIPI -=7130↔ DAC B1
01100 ADDI =7130↔ LIPI -=7128↔ DAC B2
01200 ADDI =7128↔ LIPI -=7128↔ DAC B3
01300 ADDI =7128↔ LIPI -=7130↔ DAC B4
01400 LL5:
01500 ;DAC DUMARG
01600 OUT 1,B1↔OUTSTR[ASCIZ/ FIRE BUFFER 1 !/]↔CRLF
01700 OUT 1,B2↔OUTSTR[ASCIZ/ FIRE BUFFER 2 !/]↔CRLF
01800 OUT 1,B3↔OUTSTR[ASCIZ/ FIRE BUFFER 3 !/]↔CRLF
01900 OUT 1,B4↔OUTSTR[ASCIZ/ FIRE BUFFER 4 !/]↔CRLF
02000 UNLOCK
02100 RELEASE 1,
02200
02300
02400 LAC SAV44↔CORE
02500 L5: OUTSTR[ASCIZ/ XGP CORE UUO FAILED.
02600 /]↔ CRLF↔LAC SAVSEG↔ATTSEG↔JFCL↔POP0J
02700
02800
02900 ;HALF TONE TABLE.
03000 HTT: 6↔7↔7↔6↔ 6↔6↔7↔6↔ 6↔6↔6↔6↔ 6↔6↔6↔6
03100 6↔6↔6↔4↔ 4↔6↔6↔4↔ 4↔6↔6↔4↔ 4↔4↔6↔4
03200 4↔4↔4↔4↔ 4↔4↔4↔4↔ 0↔4↔4↔4↔ 4↔4↔4↔0
03300 0↔4↔4↔0↔ 0↔0↔4↔0↔ 0↔0↔4↔0↔ 0↔0↔0↔0
03400 DUMARG:0↔0
03500 B1:0↔0
03600 B2:0↔0
03700 B3:0↔0
03800 B4:0↔0
03900 BEND;1/19/73-------------------------------------------------------
00100 SUBR(VICXGP)Q1,Q2 VIDEO INTENSITY CONTOURS TO XGP.
00200 BEGIN VICXGP;-----------------------------------------------------
00300 ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2}
00400 EXTERN VSEG,HSEG,TVBUF,THRESH,PACXOR
00500 ;BIT POSITIONS OF THE ARGUMENTS Q1 & Q2 ENABLE INTENSITY CUTS.
00600 LAC 1,ARG2↔DAC 1,Q0#
00700 LAC 1,ARG1↔ANDCMI 1,377↔DAC 1,Q1#
00800 DZM CUT#
00900 ;CLEAR THE TMP AREA FOR VSEG-HSEG ACCUMULATION.
01000 LAC[XWD SKY,SKY+1]↔DZM SKY↔BLT SKY+=3500
01100
01200 ;FIND AN INTENSITY CONTOUR ENABLE BIT.
01300 LL0: LAC 0,Q0↔LAC 1,Q1
01400 LL1: AOS 2,CUT↔LSHC 0,1↔JUMPL 0,LL2
01500 CAMN 0,1↔JUMPE 0,LL5↔GO LL1
01600
01700 ;THRESHOLD THE TVBUF
01800 LL2: DAC 0,Q0↔DAC 1,Q1
01900 CALL(THRESH,CUT)
02000 CALL(PACXOR)
02100 LACI 1,=3457↔LAC VSEG(1)↔IORM SKY(1)↔SOJG 1,.-2
02200 GO LL0
02300
02400 LL5: LAC[XWD SKY,VSEG]↔BLT VSEG+=3456
00100
00200 ;PACK VSEG'S AND HSEG'S INTO THE TVBUF.
00300 LAC[XWD LL3,2]↔BLT 14↔GO 3
00400 LL3: =62208 ;2
00500 ILDB 0,11 ;3
00600 ILDB 1,12 ;4 ;GET HSEG BIT.
00700 DPB 1,14 ;5 ;COMBINE THEM.
00800 IDPB 0,13 ;6 ;PACK THEM INTO TVBUF.
00900 SOJG 2,3 ;7
01000 GO LL4 ;10
01100 POINT 1,VSEG ;11
01200 POINT 1,HSEG ;12
01300 POINT 6,TVBUF ;13
01400 POINT 1,0,34 ;14
01500 LL4:
00100
00200 ;EXPAND CORE FOR XGP BUFFER & CLEAR THE BUFFER.
00300 LAC 44↔DAC SAV44#↔AOS↔DAC XBUF#↔ADDI =28513+10↔CORE↔GO L5
00400 CDR 1,XBUF↔DZM(1)↔DIP 1,1↔AOS 1↔CDR 2,44↔BLT 1,(2)
00500
00600 ;PUT CONTROL WORDS IN THE 864 ROWS OF THE XGP IMAGE.
00700 LAC 1,XBUF
00800 SLACI %↔DAC(1)↔AOS 1 ;CUT PAPER.
00900 SLACI =200⊗6↔DAC(1)↔AOS 1 ;SPACE DOWN 100 LINES.
01000 LAC[1B11+=192B23+=32]↔LACI 2,=864 ;864 ROWS OF 32 WORDS.
01100 DAC(1)↔ADDI 1,=33↔SOJG 2,.-2
01200 LAC[5770B11]↔DAC(1)↔AOS 1 ;SPACE AFTER PICTURE.
01300 SLACI %↔DAC(1) ;CUT PAPER.
01400
01500 ;PACK VIDEO BYTES INTO XGP 4 BY 4 BIT ARRAYS.
01600 LAC P1,[POINT 6,TVBUF,-1]
01700 LAC P2,XBUF↔ADDI P2,3 ;BUFFER POINTER.
01800 LACI I,=216
01900 L1: LACI J,=32
02000 L2: SETZB 0,1↔SETZB 2,3↔LACI K,=9
02100 L3: ILDB Q,P1↔LSH Q,2
02200 CAIN J,=32↔GO[CAIN K,9↔IORI Q,4↔GO .+1]
02300 CAMN J,K↔GO[CAIN J,1↔LACI Q,4↔GO .+1]
02400 CAIE I,=216↔CAIN I,1↔IORI Q,8
02500 ROTC 0,4↔ROTC 2,4
02600 IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)
02700 IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)
02800 SOJG K,L3
02900 DAC 0,=00(P2)↔DAC 1,=33(P2)
03000 DAC 2,=66(P2)↔DAC 3,=99(P2)
03100 AOS P2↔SOJG J,L2
03200 ADDI P2,=100↔SOJG I,L1
03300
03400 ;GRAB THE DEVICE.
03500 L4: INIT 1,17↔SIXBIT/XGP/↔0↔GO[OUTSTR[ASCIZ/XGP INIT FAILED.
03600 /]↔ POP2J]↔SETZ↔SEGNUM↔DAC SAVSEG#↔DETSEG
03700 SLACI -=28516↔LAP XBUF↔SOS↔DAC DUMARG
03800 OUT 1,DUMARG↔RELEASE 1,↔LAC SAV44↔CORE
03900 L5: OUTSTR[ASCIZ/ XGP CORE UUO FAILED.
04000 /]↔ CRLF↔LAC SAVSEG↔ATTSEG↔JFCL↔POP2J
04100 ;HALF TONE TABLE.
04200 HTT: 0↔0↔0↔0↔ 8↔8↔8↔8↔ 17↔0↔0↔0↔ 17↔8↔8↔8
04300 DUMARG:0↔0
04400 BEND VICXGP; BGB 6 MAY 1973 ---------------------------------------
00100 SUBR(CREOUT) OUTPUT CONTOURS, REGION, EDGE FILE.
00200 BEGIN CREOUT;-----------------------------------------------------
00300 CALL(SHRINQ)
00400 CALL(GETFIL,[SIXBIT/CRE/],[0])↔POP0J
00500 LACN FILM
00600 CALL(RELLOC,0)
00700
00800 ;SETUP DUMP OUT ARGUMENT IOWD.
00900 LAC FILM↔SUB@AVAIL2
01000 LACM 1,0↔MOVSS
01100 LAP CRE44↔DAC OUTARG
01200 LAC@FILM↔DAC TMP#↔DAC 1,@FILM ;FILE SIZE IN WORDS.
01300
01400 ;FILE OUTPUT RITUAL.
01500 LAC@AVAIL2↔SUB FILM↔DAC@AVAIL2
01600 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
01700 ENTER 1,FILNAM
01800 GO[OUTSTR[ASCIZ/ ENTER FAILED.
01900 /]↔GO .+4]
02000 OUT 1,OUTARG↔JFCL
02100 OUTSTR[ASCIZ" EOF.
02200 "]↔ RELEASE 1,
02300 DZM FILNAM↔SETZ EXTION↔DZM EXTION+1↔DZM PPPN
02400 CALL(RELLOC,FILM)
02500 LAC TMP↔DAC@FILM
02600 LAC@AVAIL2↔ADD FILM↔DAC@AVAIL2
02700 POP0J
02800 OUTARG: 0↔0
02900 BEND CREOUT; BGB 6 DECEMBER 1972 ---------------------------------
00100 SUBR(CREIN) CONTOUR,REGION,EDGE FILE FORMAT INPUT.
00200 BEGIN CREIN;------------------------------------------------------
00300
00400 CALL(GETFIL,[SIXBIT/CRE/],[0])↔POP0J
00500 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
00600 LOOKUP 1,FILNAM↔GO[RELEASE 1,↔GO CREIN]
00700
00800 DZM QBLK
00900 LAC PPPN↔LAP FILM↔SOS↔DAC INARG ;IOWD
01000
01100 MOVS PPPN↔MOVMS↔ADD FILM
01200 IORI 1777↔CAMG 44↔GO L1
01300 CALLI 11↔HALT
01400 LAC 44↔AOS↔SUB FILM
01500 DIVI 7↔DAC 1,REMAINDER
01600 L1: IN 1,INARG
01700 OUTSTR[ASCIZ" EOF.
01800 "]↔ RELEASE 1,
01900
02000 CDR@AVAIL2↔ADD FILM↔DAC@AVAIL2↔DZM@
02100 DIP↔AOS↔LAC 1,44↔BLT(1) ;CLEAR EMPTY AREA.
02200 CALL(RELLOC,FILM)
02300
02400 ;RESET AVAIL2 LIST.
02500 LAC 1,@AVAIL2↔LAC 2,44
02600 LIPI 1,NODSIZ(1)↔GO L6
02700 L5: HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
02800 L6: CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L5
02900 SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
03000 POP0J
03100 INARG: 0↔0
03200 BEND CREIN; BGB 28 JANUARY 1973 ----------------------------------
00100 ;TVIN4. FOUR BIT TELEVISION INPUT.
00200 SUBR(TVIN4)------------------------------------------------------
00300 BEGIN TVIN4
00400 LAC 44↔DAC TMP44#↔AOS↔DAP TVPTR
00500 ADDI=6912↔CORE↔POP0J
00600 L0: INIT 17,17↔SIXBIT/TV/↔0
00700 GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
00800 DZM TVERR↔INPUT 17,TVPTR↔RELEASE 17,
00900
01000 ;REPORT ON THE ERROR BITS AND RETAKE IF NECESSARY;
01100 LAC 1,TVERR
01200 TRNE 1,100000↔OUTSTR[ASCIZ/TV PARITY ERROR.
01300 /]↔ TRNE 1,000040↔OUTSTR[ASCIZ/TV DATA MISS.
01400 /]↔ TRNE 1,000020↔OUTSTR[ASCIZ/TV NON EX MEM.
01500 /]↔ TRNE 1,100060↔JRST L0
01600 TIMER↔DAC TVTIME#
01700 DATE↔DAC TVDATE#
01800 OUTSTR[ASCIZ/AKEN./]
01900 LAC[XWD HISTO,HISTO+1] ;CLEAR THE HISTOGRAM.
02000 DZM HISTO↔BLT HISTO+77
02100
02200 ;CONVERT FROM GREY CODE TO GRAY CODE.
02300 LAC 16,[XWD L,0]↔BLT 16,12
02400 LAP TVPTR↔GO 4
02500
02600 L: POINT 4,0,-1↔ FROM←←0
02700 POINT 6,TVBUF,-1↔ TO←←1
02800 =62208 ↔ CNT←←2
02900 0 ↔ BYT←←3
03000 ILDB BYT,FROM ;4
03100 LAC BYT,GRAY(BYT) ;3
03200 LSH BYT,2 ;6
03300 AOS HISTO(BYT) ;7
03400 IDPB BYT,TO ;8
03500 SOJG CNT,4 ;9
03600 GO .+1 ;12
03700 LAC TMP44↔CORE↔HALT↔POP0J
03800
03900 BEND TVIN4; BGB 14 DECEMBER 1972 ---------------------------------
04000
04100 TVPTR: XWD -=6912,0 ↔ INTERN TVPTR
04200 TVCLIP: 701002 ;BCLIP=7 TCLIP=0 CAM=1.
04300 INTERN TVCLIP
04400 TVYXW: BYTE(9)50,34,40
04500 TVERR: 0
04600 GRAY: OCT 12,13,11,10,15,14,16,17,5,4,6,7,2,3,1,0
00100 SUBR(TVIN6). SIX BIT TELEVISION INPUT.
00200 BEGIN TVIN6;-----------------------------------------------------
00300 LAC 44↔DAC TMP44#↔AOS↔DAP TVPTR
00400 ADDI=6912*4↔CORE↔POP0J
00500 L0: INIT 17,17↔SIXBIT/TV/↔0
00600 GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
00700 DZM TVERR6#↔PUSH P,TVCLIP
00800
00900 LACI 76↔DPB[POINT 6,TVCLIP,23] ;TAKE CLIPS 76.
01000 LAC TVPTR↔LIPI 440400↔DAC P1#
01100 L1: DZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
01200 IORM TVERR6↔TRNE 100060↔GO L1
01300
01400 LACI 54↔DPB[POINT 6,TVCLIP,23] ;TAKE CLIPS 54.
01500 LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P2#
01600 L2: DZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
01700 IORM TVERR6↔TRNE 100060↔GO L2
01800
01900 LACI 32↔DPB[POINT 6,TVCLIP,23] ;TAKE CLIPS 32.
02000 LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P3#
02100 L3: DZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
02200 IORM TVERR6↔TRNE 100060↔GO L3
02300
02400 LACI 10↔DPB[POINT 6,TVCLIP,23] ;TAKE CLIPS 10.
02500 LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P4#
02600 L4: DZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
02700 IORM TVERR6↔TRNE 100060↔GO L4
02800 POP P,TVCLIP↔RELEASE 17,
02900
03000 ;REPORT ON THE ERROR BITS.
03100 LAC 1,TVERR6
03200 TRNE 1,100000↔OUTSTR[ASCIZ/TV PARITY ERROR.
03300 /]↔ TRNE 1,40 ↔OUTSTR[ASCIZ/TV DATA MISS.
03400 /]↔ TRNE 1,20 ↔OUTSTR[ASCIZ/TV NON EX MEM.
03500 /]↔ TIMER↔DAC TVTIME#
03600 DATE↔DAC TVDATE#
03700 LAC[XWD HISTO,HISTO+1]↔DZM HISTO↔BLT HISTO+77
03800 OUTSTR[ASCIZ/AKEN./]
03900 ;CONVERT FROM GREY CODE TO GRAY CODE.
04000 LAC[POINT 6,TVBUF,-1]↔DAC P5#
04100 LAC[XWD L,3]↔BLT 16↔LACI =62208↔GO 3
04200
04300 ;SIX BIT AC-LOOP.
04400 L: ILDB 1,P1↔LAC 2,GRAY(1)
04500 ILDB 1,P2↔ADD 2,GRAY(1)
04600 ILDB 1,P3↔ADD 2,GRAY(1)
04700 ILDB 1,P4↔ADD 2,GRAY(1)
04800 IDPB 2,P5↔AOS HISTO(2)
04900 SOJG 0,3↔GO .+1
05000 LAC TMP44↔CORE↔HALT↔POP0J
05100 BEND TVIN6; BGB 14 DECEMBER 1972 ---------------------------------
05200 END